home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / Pascal I⁄O Extensions / XPascalIO.p < prev   
Encoding:
Text File  |  1996-12-17  |  3.4 KB  |  151 lines  |  [TEXT/PJMM]
  1. Unit XPascalIO;
  2.  
  3. {***************************************************}
  4. {*                                                    }
  5. {*   Some extensions to the Pascal I/O facilities    }
  6. {*   to interface them more harmoniously with        }
  7. {*   the File Manager.                                }
  8. {*                                                    }
  9. {*   By Greg Ewing (greg@cosc.canterbury.ac.nz,        }
  10. {*   http://www.cosc.canterbury.ac.nz/~greg)        }
  11. {*   November 1996                                    }
  12. {*   Freeware and Use-at-your-own-risk-ware.        }
  13. {*                                                    }
  14. {*   Updated to CodeWarrior project, 12/17/96.        }
  15. {*   Bill Catambay.                                    }
  16. {*                                                    }
  17. {***************************************************}
  18.  
  19. Interface
  20.  
  21. Uses
  22.     Files, StandardFile, Types;
  23.     
  24. {    FSpReset opens an existing file for reading as Pascal text file, given an FSSpec.}
  25. Procedure FSpReset (var f: text; spec: FSSpec);
  26.  
  27. {    FSpRewrite creates a new file with the given type and creator codes, and }
  28. {    opens it for writing as a Pascal text file. }
  29. Procedure FSpRewrite (var f: text; spec: FSSpec; fileType, fileCreator: OSType);
  30.  
  31. {    XIOResult may be called to find out the result of the last call to any of the above }
  32. {    routines. Returns noErr if the call succeeded; otherwise it may return either an }
  33. {    Operating System error code, or a return value from IOResult. }
  34. Function XIOResult: OSErr;
  35.  
  36. {    GetOldFile prompts the user for the name of an existing file. One file type }
  37. {    may be specified. (If you need to use more than one file type, use StandardGetFile.) }
  38. Function GetOldFile (fileType: OSType; var spec: FSSpec): boolean;
  39.  
  40. {    GetNewFile prompts the user for the name of a new file. Returns true unless}
  41. {    the dialog is cancelled.}
  42. Function GetNewFile (prompt, defaultName: Str255; var spec: FSSpec): boolean;
  43.  
  44.  
  45. Implementation
  46.  
  47. Var
  48.     gXIOResult: OSErr;
  49.  
  50. Procedure Ignore (x: univ longint);
  51.  
  52.     begin
  53.     { procedure to ignore function return values }
  54.     end;
  55.  
  56. Procedure FSpReset (var f: text; spec: FSSpec);
  57.  
  58. Var
  59.     oldVRefNum: integer;
  60.  
  61.     Procedure Check (result: OSErr);
  62.  
  63.         begin
  64.         if result <> noErr then 
  65.             begin
  66.             gXIOResult := result;
  67.             exit(FSpReset);
  68.             end;
  69.         end;
  70.  
  71.     begin {FSpReset}
  72.     gXIOResult := noErr;
  73.     Ignore(GetVol(nil, oldVRefNum));
  74.     Check(HSetVol(nil, spec.vRefNum, spec.parID));
  75.     reset(f, spec.name);
  76.     Check(IOResult);
  77.     Ignore(SetVol(nil, oldVRefNum));
  78.     end;
  79.  
  80. Procedure FSpRewrite (var f: text; spec: FSSpec; fileType, fileCreator: OSType);
  81.  
  82. Var
  83.     oldVRefNum: integer;
  84.     info: FInfo;
  85.  
  86.     Procedure Check (result: OSErr);
  87.  
  88.         begin
  89.         if result <> noErr then 
  90.             begin
  91.             gXIOResult := result;
  92.             exit(FSpRewrite);
  93.             end;
  94.         end;
  95.  
  96.     begin
  97.     gXIOResult := noErr;
  98.     Ignore(GetVol(nil, oldVRefNum));
  99.     Ignore(HSetVol(nil, spec.vRefNum, spec.parID));
  100.     rewrite(f, spec.name);
  101.     Check(IOResult);
  102.     Check(FSpGetFInfo(spec, info));
  103.     info.fdType := fileType;
  104.     info.fdCreator := fileCreator;
  105.     Check(FSpSetFInfo(spec, info));
  106.     Ignore(SetVol(nil, oldVRefNum));
  107.     end;
  108.  
  109. Function XIOResult: OSErr;
  110.  
  111.     begin
  112.     XIOResult := gXIOResult;
  113.     end;
  114.  
  115. Function GetOldFile (fileType: OSType; var spec: FSSpec): boolean;
  116.  
  117. Var
  118.     reply: StandardFileReply;
  119.     types: SFTypeList;
  120.  
  121.     begin
  122.     types[0] := fileType;
  123.     StandardGetFile(NIL, 1, @types, reply);
  124.     if reply.sfGood then 
  125.         begin
  126.         spec := reply.sfFile;
  127.         GetOldFile := true;
  128.         end
  129.     else
  130.         GetOldFile := false;
  131.     end;
  132.  
  133. Function GetNewFile (prompt, defaultName: Str255; var spec: FSSpec): boolean;
  134.  
  135. Var
  136.     reply: StandardFileReply;
  137.     types: SFTypeList;
  138.  
  139.     begin
  140.     types[0] := 'TEXT';
  141.     StandardPutFile(prompt, defaultName, reply);
  142.     if reply.sfGood then 
  143.         begin
  144.         spec := reply.sfFile;
  145.         GetNewFile := true;
  146.         end
  147.     else
  148.         GetNewFile := false;
  149.     end;
  150.  
  151. end.